home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / bin / tkpasswd < prev    next >
Text File  |  1995-07-21  |  16KB  |  601 lines
  1. #!/usr/skunk/bin/expectk -f
  2. # tkpasswd - Change passwords using Expectk
  3. # Author: Don Libes, NIST, October 1, 1993
  4. # Version: 1.6 - Improved autogeneration of passwords
  5.  
  6. # There is no man page.  However, there is some on-line help when you run
  7. # the program.  Technical details and insights are described in the
  8. # O'Reilly book "Exploring Expect".
  9.  
  10. frame .type -relief raised -bd 1
  11. radiobutton .passwd -text passwd -variable passwd_cmd \
  12.         -value {passwd {cat /etc/passwd}} \
  13.         -anchor w -command get_users -relief flat
  14. radiobutton .yppasswd -text yppasswd -variable passwd_cmd \
  15.         -value {yppasswd {ypcat passwd}} \
  16.         -anchor w -command get_users -relief flat
  17. pack .passwd .yppasswd -in .type -fill x 
  18. pack .type -fill x
  19.  
  20. frame .sort -relief raised -bd 1
  21. radiobutton .unsorted -text unsorted -variable sort_cmd -value " " \
  22.         -anchor w -relief flat -command get_users
  23. radiobutton .name -text name -variable sort_cmd -value "| sort" \
  24.         -anchor w -relief flat -command get_users
  25. radiobutton .uid -text uid -variable sort_cmd -value "| sort -t: -n +2" \
  26.          -anchor w -relief flat -command get_users
  27. pack .unsorted .name .uid -in .sort -fill x
  28. pack .sort -fill x
  29.  
  30. frame .users -relief raised -bd 1
  31. # has to be wide enough for 8+1+5=14
  32. text .names -yscrollcommand ".scroll set" -width 14 -height 1 \
  33.         -font "*-bold-o-normal-*-120-*-m-*" -setgrid 1
  34. .names tag configure nopassword -relief raised
  35. .names tag configure selection -relief raised
  36. if {[tk colormodel .]=="color"} {
  37.     .names tag configure nopassword -background red
  38.     .names tag configure selection -background green
  39. } else {
  40.     .names tag configure nopassword -background  black -foreground white
  41.     .names tag configure selection -background white -foreground black
  42. }
  43. scrollbar .scroll -command ".names yview" -relief raised
  44. pack .scroll -in .users -side left -fill y
  45. pack .names  -in .users -side left -fill y
  46. pack .users -expand 1 -fill y
  47.  
  48. wm minsize . 14 1
  49. wm maxsize . 14 999
  50. wm geometry . 14x10
  51.  
  52. frame .password_frame -relief raised -bd 1
  53. entry .password -textvar password -relief sunken -width 1
  54. focus .password
  55. bind .password <Return> password_set
  56. label .prompt -text "Password:" -bd 0
  57. button .password_set -text "set" -command password_set
  58. button .generate_button -text "generate" -command password_generate
  59. pack .prompt .password -in .password_frame -fill x -padx 2 -pady 2
  60. pack .password_set .generate_button -in .password_frame -side left -expand 1 -fill x -padx 2 -pady 2
  61. pack .password_frame -fill x
  62.  
  63. set dict_loaded 0
  64. checkbutton .dict -text "test dictionary" -variable dict_check \
  65.         -command {if !$dict_loaded load_dict} \
  66.         -anchor w
  67. pack .dict -fill x -padx 2 -pady 2
  68.  
  69.  
  70. button .quit -text quit -command exit
  71. button .help_button -text help -command help
  72. pack .quit .help_button -side left -expand 1 -fill x -padx 2 -pady 2
  73.  
  74. proc help {} {
  75.     if [catch {toplevel .help}] return
  76.     message .help.text -text \
  77. "tkpasswd - written by Don Libes, NIST, 10/1/93.
  78.  
  79. Click on passwd (local users) or yppasswd (NIS users).\
  80. Select user using mouse (or keys - see below).\
  81. Enter password or press ^G to generate a random password.\
  82. (Press ^A to adjust the generation parameters.)\
  83. Press return to set the password.\
  84. If the dictionary is enabled and the password is in it,\
  85. the password is rejected.
  86.  
  87. You must be root to set local passwords besides your own.\
  88. If you are not root, you must also enter an old password\
  89. when requested.
  90.  
  91. You do not have to move mouse into password field(s) to enter password.\
  92. ^U clears password field.\
  93. ^N and ^P select next/previous user.\
  94. M-n and M-p select next/previous user with no password.\
  95. (Users with no passwords are highlighted.)"
  96.  
  97.     button .help.ok -text "ok" -command {destroy .help}
  98.     pack .help.text
  99.     pack .help.ok -fill x -padx 2 -pady 2
  100. }
  101.  
  102. # get list of local users
  103. proc get_users {} {
  104.     global sort_cmd passwd_cmd
  105.     global nopasswords    ;# line numbers of entries with no passwords
  106.     global last_line    ;# last line of text box
  107.     global selection_line
  108.  
  109.     .names delete 1.0 end
  110.  
  111.     set file [open "|[lindex $passwd_cmd 1] $sort_cmd"]
  112.     set last_line 1
  113.     set nopasswords {}
  114.     while {[gets $file buf] != -1} {
  115.         set buf [split $buf :]
  116.         if [llength $buf]>2 {
  117.             # normal password entry
  118.             .names insert end "[format "%-8s %5d" [lindex $buf 0] [lindex $buf 2]]\n"
  119.             if 0==[string compare [lindex $buf 1] ""] {
  120.                 .names tag add nopassword \
  121.                     {end - 1 line linestart} \
  122.                     {end - 1 line lineend}
  123.                 lappend nopasswords $last_line
  124.             }
  125.         } else {
  126.             # +name style entry
  127.             .names insert end "$buf\n"
  128.         }
  129.         incr last_line
  130.     }
  131.     incr last_line -1
  132.     close $file
  133.     set selection_line 0
  134. }
  135.  
  136. proc feedback {msg} {
  137.     global password
  138.  
  139.     set password $msg
  140.     .password select from 0
  141.     .password select to end
  142.     update
  143. }
  144.  
  145. proc load_dict {} {
  146.     global dict dict_loaded
  147.  
  148.     feedback "loading dictionary..."
  149.  
  150.     if 0==[catch {open /usr/dict/words} file] {
  151.         rename set s
  152.         foreach w [split [read $file] "\n"] {s dict($w) ""}
  153.         close $file
  154.         rename s set
  155.         set dict_loaded 1
  156.         feedback "dictionary loaded"
  157.     } else {
  158.         feedback "dictionary missing"
  159.         .dict deselect
  160.     }
  161. }
  162.  
  163. # put whatever security checks you like in here
  164. proc weak_password {password} {
  165.     global dict dict_check
  166.  
  167.     if $dict_check {
  168.         feedback "checking password"
  169.  
  170.         if [info exists dict($password)] {
  171.             feedback "sorry - in dictionary"
  172.             return 1
  173.         }
  174.     }
  175.     return 0
  176. }
  177.  
  178. proc password_set {} {
  179.     global password passwd_cmd selection_line
  180.  
  181.     set new_password $password
  182.  
  183.     if {$selection_line==0} {
  184.         feedback "select a user first"
  185.         return
  186.     }
  187.     set user [lindex [.names get selection.first selection.last] 0]
  188.  
  189.     if [weak_password $password] return
  190.  
  191.     feedback "setting password . . ."
  192.  
  193.     set cmd [lindex $passwd_cmd 0]
  194.     spawn -noecho $cmd $user
  195.     log_user 0
  196.     set last_msg "error in $cmd"
  197.     while 1 {
  198.         expect {
  199.             -nocase "old password:" {
  200.                 exp_send "[get_old_password]\r"
  201.             } "assword:" {
  202.                 exp_send "$new_password\r"
  203.             } -re "(.*)\r\n" {
  204.                 set last_msg $expect_out(1,string)
  205.             } eof break
  206.         }
  207.     }
  208.     set status [wait]
  209.     if [lindex $status 3]==0 {
  210.         feedback "set successfully"
  211.     } else {
  212.         feedback $last_msg
  213.     }
  214. }
  215.  
  216. # defaults for generating passwords
  217. set length 9
  218. set minnum 2
  219. set minlower 5
  220. set minupper 2
  221. set distribute 0
  222.  
  223. proc parameter_filename {} {
  224.     set file .tkpasswd.rc
  225.     if [info exists env(DOTDIR)] {
  226.         set file "$env(DOTDIR)/$file"
  227.     }
  228.     return ~/$file
  229. }
  230.  
  231. catch {source [parameter_filename]}
  232.  
  233. # save parameters in a file
  234. proc save_parameters {} {
  235.     global minnum minlower minupper length
  236.  
  237.     if [catch {open [parameter_filename] w} f] {
  238.         # should never happen, so don't bother with window code
  239.         puts "tkpasswd: could not write [parameter_filename]"
  240.         return
  241.     }
  242.     puts $f "# This is the .tkpasswd.rc file.  Do not edit it by hand as"
  243.     puts $f "# it is automatically maintained by tkpasswd.  Any manual"
  244.     puts $f "# modifications will be lost."
  245.     puts $f ""
  246.     puts $f "set length $length"
  247.     puts $f "set minnum $minnum"
  248.     puts $f "set minupper $minupper"
  249.     puts $f "set minlower $minlower"
  250.     close $f
  251. }
  252.  
  253. # insert char into password at a random position
  254. proc insert {pvar char} {
  255.     upvar $pvar p
  256.  
  257.     set p [linsert $p [rand [expr 1+[llength $p]]] $char]
  258. }
  259.  
  260. # given a size, distribute between left and right hands
  261. # taking into account where we left off
  262. proc psplit {max lvar rvar} {
  263.     upvar $lvar left $rvar right
  264.     global isleft
  265.  
  266.     if {$isleft} {
  267.         set right [expr $max/2]
  268.         set left [expr $max-$right]
  269.         set isleft [expr !($max%2)]
  270.     } else {
  271.         set left [expr $max/2]
  272.         set right [expr $max-$left]
  273.         set isleft [expr $max%2]
  274.     }
  275. }
  276.  
  277. proc password_generate {} {
  278.     global password length minnum minlower minupper
  279.     global lpass rpass initially_left isleft
  280.     global distribute
  281.  
  282.     if {$distribute} {
  283.        set lkeys {q w e r t a s d f g z x c v b}
  284.        set rkeys {y u i o p h j k l n m}
  285.        set lnums {1 2 3 4 5 6}
  286.        set rnums {7 8 9 0}
  287.     } else {
  288.        set lkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z}
  289.        set rkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z}
  290.        set lnums {0 1 2 3 4 5 6 7 8 9}
  291.        set rnums {0 1 2 3 4 5 6 7 8 9}
  292.     }
  293.     set lkeys_length [llength $lkeys]
  294.     set rkeys_length [llength $rkeys]
  295.     set lnums_length [llength $lnums]
  296.     set rnums_length [llength $rnums]
  297.  
  298.     # if there is any underspecification, use additional lowercase letters
  299.     set minlower [expr $length - ($minnum + $minupper)]
  300.  
  301.  
  302.     set lpass ""        ;# password chars typed by left hand
  303.     set rpass ""        ;# password chars typed by right hand
  304.     set password ""        ;# merged password
  305.  
  306.     # choose left or right starting hand
  307.     set initially_left [set isleft [rand 2]]
  308.  
  309.     psplit $minnum left right
  310.     for {set i 0} {$i<$left} {incr i} {
  311.         insert lpass [lindex $lnums [rand $lnums_length]]
  312.     }
  313.     for {set i 0} {$i<$right} {incr i} {
  314.         insert rpass [lindex $rnums [rand $rnums_length]]
  315.     }
  316.  
  317.     psplit $minlower left right
  318.     for {set i 0} {$i<$left} {incr i} {
  319.         insert lpass [lindex $lkeys [rand $lkeys_length]]
  320.     }
  321.     for {set i 0} {$i<$right} {incr i} {
  322.         insert rpass [lindex $rkeys [rand $rkeys_length]]
  323.     }
  324.  
  325.     psplit $minupper left right
  326.     for {set i 0} {$i<$left} {incr i} {
  327.         insert lpass [string toupper [lindex $lkeys [rand $lkeys_length]]]
  328.     }
  329.     for {set i 0} {$i<$right} {incr i} {
  330.         insert rpass [string toupper [lindex $rkeys [rand $rkeys_length]]]
  331.     }
  332.  
  333.     # merge results together
  334.     if {$initially_left} {
  335.         regexp "(\[^ ]*) *(.*)" "$lpass" x password lpass
  336.         while {[llength $lpass]} {
  337.             regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass
  338.             regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass
  339.         }
  340.         if {[llength $rpass]} {
  341.             append password $rpass
  342.         }        
  343.     } else {
  344.         regexp "(\[^ ]*) *(.*)" "$rpass" x password rpass
  345.         while {[llength $rpass]} {
  346.             regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass
  347.             regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass
  348.         }
  349.         if {[llength $lpass]} {
  350.             append password $lpass
  351.         }        
  352.     }
  353. }
  354.  
  355. set _ran [pid]
  356. proc rand {m} {
  357.     global _ran
  358.  
  359.     set period 233280
  360.     set _ran [expr ($_ran*9301 + 49297) % $period]
  361.     expr int($m*($_ran/double($period)))
  362. }
  363.  
  364. proc gen_bad_args {msg} {
  365.     if ![llength [info commands .parameters.errmsg]] {
  366.         message .parameters.errmsg -aspect 300
  367.         pack .parameters.errmsg
  368.     }
  369.     .parameters.errmsg configure -text "$msg\
  370. Please adjust the password generation arguments."
  371. }
  372.  
  373.  
  374. # tell tab what window to move between
  375. set parm_tabList {}
  376.  
  377. # The procedure below is invoked in response to tabs in the entry
  378. # windows.  It moves the focus to the next window in the tab list.
  379. # Arguments:
  380. #
  381. # list -    Ordered list of windows to receive focus
  382.  
  383. proc Tab {list} {
  384.     set i [lsearch $list [focus]]
  385.     if {$i < 0} {
  386.     set i 0
  387.     } else {
  388.     incr i
  389.     if {$i >= [llength $list]} {
  390.         set i 0
  391.     }
  392.     }
  393.     focus [lindex $list $i]
  394. }
  395.  
  396. # adjust args used in password generation
  397. proc adjust_parameters {} {
  398.     global parm_tabList
  399.     set parm_tabList {}
  400.  
  401.     toplevel [set w .parameters]
  402.  
  403. #    wm title $w ""
  404. #    wm iconname $w ""
  405.  
  406.     message $w.text -aspect 300 -text \
  407. "These parameters control generation of random passwords.
  408.  
  409. It is not necessary to move the mouse into this window to operate it.\
  410. Press <tab> to move to the next entry.\
  411. Press <return> or click the <ok> button when you are done."
  412.  
  413.     foreach desc {
  414.       {length {total length}}
  415.       {minnum {minimum number of digits}}
  416.       {minupper {minimum number of uppercase letters}}
  417.       {minlower {minimum number of lowercase letters}}} {
  418.         set name [lindex $desc 0]
  419.         set text [lindex $desc 1]
  420.         frame $w.$name -bd 1
  421.         entry $w.$name.entry -relief sunken -width 2 -textvar $name
  422.         bind $w.$name.entry <Tab> "Tab \$parm_tabList"
  423.         bind $w.$name.entry <Return> "destroy_parm_window"
  424.         label $w.$name.text -text $text
  425.         pack $w.$name.entry -side left
  426.         pack $w.$name.text -side left
  427.         lappend parm_tabList $w.$name.entry
  428.     }
  429.     frame $w.2 -bd 1
  430.     checkbutton $w.2.cb -text "alternate characters across hands" \
  431.         -relief flat -variable distribute
  432.     pack $w.2.cb -side left
  433.  
  434.     button $w.ok -text "ok" -command "destroy_parm_window"
  435.     pack $w.text -expand 1 -fill x
  436.     pack $w.length $w.minnum $w.minupper $w.minlower $w.2 -expand 1 -fill x
  437.     pack $w.ok -side left -fill x -expand 1 -padx 2 -pady 2
  438.  
  439. #strace 10
  440.     set oldfocus [focus]
  441. #    $w.length.entry icursor end
  442.     tkwait visibility $w.length.entry
  443.     focus $w.length.entry
  444. #    grab $w
  445.     tkwait window $w
  446. #    grab release $w
  447.     focus $oldfocus
  448.  
  449. #strace 0
  450.  
  451.     save_parameters    
  452. }
  453.  
  454. proc isnumber {n} {
  455.     regexp "^\[0-9\]+$" $n
  456. }
  457.  
  458. # destroy parm window IF all values are legal
  459. proc destroy_parm_window {} {
  460.     global minnum minlower minupper length
  461.  
  462.     set mustbe "must be a number greater than or equal to zero."
  463.  
  464.     # check all variables
  465.     if {![isnumber $length]} {
  466.         gen_bad_args "The total length $mustbe"
  467.         return
  468.     }
  469.     if {![isnumber $minlower]} {
  470.         gen_bad_args "The minimum number of lowercase characters $mustbe"
  471.         return
  472.     }
  473.     if {![isnumber $minupper]} {
  474.         gen_bad_args "The minimum number of uppercase characters $mustbe"
  475.         return
  476.     }
  477.     if {![isnumber $minnum]} {
  478.         gen_bad_args "The minimum number of digits $mustbe"
  479.         return
  480.     }
  481.  
  482.     # check constraints
  483.     if {$minnum + $minlower + $minupper > $length} {
  484.         gen_bad_args \
  485. "It is impossible to generate a $length-character password with\
  486. $minnum number[pluralize $minnum],\
  487. $minlower lowercase letter[pluralize $minlower], and\
  488. $minupper uppercase letter[pluralize $minupper]."
  489.         return
  490.     }
  491.  
  492.     destroy .parameters
  493. }
  494.  
  495. # return appropriate ending for a count of "n" nouns
  496. proc pluralize {n} {
  497.     expr $n!=1?"s":""
  498. }
  499.  
  500.  
  501. proc get_old_password {} {
  502.     global old
  503.  
  504.     toplevel .old
  505.     label .old.label -text "Old password:"
  506.     catch {unset old}
  507.     entry .old.entry -textvar old -relief sunken -width 1
  508.  
  509.     pack .old.label
  510.     pack .old.entry -fill x -padx 2 -pady 2
  511.  
  512.     bind .old.entry <Return> {destroy .old}
  513.     set oldfocus [focus]
  514.     focus .old.entry
  515.     tkwait visibility .old
  516.     grab .old
  517.     tkwait window .old
  518.     focus $oldfocus
  519.     return $old
  520. }
  521.  
  522. .unsorted select
  523. .passwd invoke
  524.  
  525. proc make_selection {} {
  526.     global selection_line last_line
  527.  
  528.     .names tag remove selection 0.0 end
  529.  
  530.     # don't let selection go off top of screen
  531.     if {$selection_line < 1} {
  532.         set selection_line $last_line
  533.     } elseif {$selection_line > $last_line} {
  534.         set selection_line 1
  535.     }
  536.     .names yview -pickplace [expr $selection_line-1]
  537.     .names tag add selection $selection_line.0 [expr 1+$selection_line].0
  538. }
  539.  
  540. proc select_next_nopassword {direction} {
  541.     global selection_line last_line
  542.     global nopasswords
  543.     
  544.     if 0==[llength $nopasswords] {
  545.         feedback "no null passwords"
  546.         return
  547.     }
  548.  
  549.     if $direction==1 {
  550.         # is there a better way to get last element of list?
  551.         if $selection_line>=[lindex $nopasswords [expr [llength $nopasswords]-1]] {
  552.             set selection_line 0
  553.         }
  554.         foreach i $nopasswords {
  555.             if $selection_line<$i break
  556.         }
  557.     } else {
  558.         if $selection_line<=[lindex $nopasswords 0] {
  559.             set selection_line $last_line
  560.         }
  561.         set j [expr [llength $nopasswords]-1]
  562.         for {} {$j>=0} {incr j -1} {
  563.             set i [lindex $nopasswords $j]
  564.             if $selection_line>$i break
  565.         }
  566.     }
  567.     set selection_line $i
  568.     make_selection
  569. }
  570.  
  571. proc select {w coords} {
  572.     global selection_line
  573.  
  574.     $w mark set insert "@$coords linestart"
  575.     $w mark set anchor insert
  576.     set first [$w index "anchor linestart"]
  577.     set last [$w index "insert lineend + 1c"]
  578.     scan $first %d selection_line
  579.  
  580.     $w tag remove selection 0.0 end
  581.     $w tag add selection $first $last
  582. }
  583.  
  584. bind Text <1> {select %W %x,%y}
  585. bind Text <Double-1> {select %W %x,%y}
  586. bind Text <Triple-1> {select %W %x,%y}
  587. bind Text <2> {select %W %x,%y}
  588. bind Text <3> {select %W %x,%y}
  589. bind Text <B1-Motion> {}
  590. bind Text <Shift-1> {}
  591. bind Text <Shift-B1-Motion> {}
  592. bind Text <B2-Motion> {}
  593.  
  594. bind .password <Control-n>    {incr selection_line 1;    make_selection}
  595. bind .password <Control-p>    {incr selection_line -1;make_selection}
  596. bind .password <Meta-n>    {select_next_nopassword 1}
  597. bind .password <Meta-p>    {select_next_nopassword -1}
  598. bind .password <Control-g>    {password_generate}
  599. bind .password <Control-a>    {adjust_parameters}
  600. bind Entry <Control-c>        {exit}
  601.